home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-03 / crsbas.zip / CROSSBAS.BAS < prev    next >
BASIC Source File  |  1990-12-01  |  56KB  |  1,408 lines
  1. '┌─────────────────────────────────────────────────────────────────────┐
  2. '└── beginning of crossbas.bas ────────────────────────────────────────┘
  3. '┌─────────────────────────────────────────────────────────────────────┐
  4. '│ CrossBas.bas                                                        │
  5. '│                                                                     │
  6. '│ This program will scan a Power-BASIC source file and create a cross-│
  7. '│ reference table of variable names and labels.  To do this we must   │
  8. '│ first read in all words in the file.  We can skip all text to the   │
  9. '│ right of "REM" or "'" remark identifiers.  After words are read in, │
  10. '│ we must compare them with PBASIC reserved words and metastatements. │
  11. '│ Finally, we alphabetize the remaining words and print them out, one │
  12. '│ word to a line, followed by the line number(s) where these words    │
  13. '│ were found.  The list will bs sorted without regard to case.        │
  14. '│                                                                     │
  15. '│ Command Line Switches:                                              │
  16. '│   /BW  Set screen colors to Black & White                           │
  17. '│   /U      Print all cross-reference variables in upper-case.           │
  18. '│   /P      Print page headers and footers.                              │
  19. '│   /S      Print cross-reference list to the screen as well as to file. │
  20. '│   /L:n Left margin n spaces.                                        │
  21. '│   /W:n Word array dimension over-ride.                              │
  22. '│                                                                     │
  23. '│                                                                     │
  24. '│ Modification History:                                               │
  25. '│                                                                     │
  26. '│ Uploaded CrossBas version 1.00P to Compuserve PCVENB, Spectra       │
  27. '│     forum.  Converted for Power-BASIC.               12/ 1/90       │
  28. '│                                                                     │
  29. '│ Added /bw switch to allow black and white screen color override.    │
  30. '│     Also, added color to default screen.             12/ 1/90       │
  31. '│                                                                     │
  32. '│ Uploaded CrossBas version 1.00 to  CompuServe BPROGA forum, LIB 9.  │
  33. '│     (Originally written for and in Turbo-BASIC.)                    │
  34. '│                                                                     │
  35. '│ KEYWORDS:  CROSS-REFERENCE, TABLE, LIST, NON-RESERVED WORDS         │
  36. '│                                                                     │
  37. '│ Description:  CrossBas will read in a Turbo-BASIC source file and   │
  38. '│     create an alphabetized cross-reference listing of non-          │
  39. '│     reserved words, i.e., variable, sub-program, function and       │
  40. '│     label names, along with the physical line number(s) where they  │
  41. '│     appear.  The list is printed to file.  Handy for cleaning       │
  42. '│     up unused variable names, labels, etc.           11/13/89       │
  43. '│                                                                     │
  44. '│ You are free to use this program as you wish.  If you find any      │
  45. '│ problems with if, please let me know about it.  If you have any     │
  46. '│ suggestions as to how to improve is, also, I'd appreciate your      │
  47. '│ help.                                                               │
  48. '│                                                                     │
  49. '│                                                                     │
  50. '│            Lester L. Noll  CompuServe id: 72250,2551                │
  51. '│            copyright (c) 11/13/89, 1990                             │
  52. '│                                                                     │
  53. '└─────────────────────────────────────────────────────────────────────┘
  54.   Title$     ="CrossBas.bas"
  55.   Ver$       ="1.00P"
  56.   Copyright$ ="Copyright (c) 11/13/90,  Lester L. Noll"
  57.   CisId$     ="72250,2551"
  58.  
  59. '┌── main program ─────────────────────────────────────────────────────┐
  60. Main:
  61.  
  62.     GOSUB Initialize            'Initialize screen, integers.
  63.     GOSUB InitScreen            'Put up init screen.
  64.     GOSUB ReadCmdLine                   'Read the DOS command line.
  65.     GOSUB OpenFiles            'Open source files and check name
  66.                         ' validity.
  67.     GOSUB CalcFileNames            'Parse filename from full path.
  68.     GOSUB ReadDefaults           'Read defaults from default file.
  69. '   GOSUB CheckStringSpace        'Check there is enough string space
  70.                     ' for infile words.
  71.                     '(Took this out for PBASIC version)
  72.     GOSUB CalcWordArraySize        'Calc word array dimension.
  73.     GOSUB PrintScreenTop        'Print top of screen report.
  74.     GOSUB ReadAndParseData        'Read source file lines and parse
  75.                     ' them into words.
  76.     GOSUB PrintScreen1            'Print read and parse report.
  77.     GOSUB Compare            'Compare source words with Power-
  78.                         ' BASIC reserved words.
  79.     GOSUB PrintScreen2            'Print compare report.
  80.     GOSUB SortWords            'Sort non-reserved words.
  81.     GOSUB PrintScreen3            'Print sort report.
  82.     GOSUB PrintList            'Print sorted words to file.
  83.     GOSUB PrintReportBtm        'Print summary report to file.
  84.     GOSUB PrintScreen4            'Print print-list report.
  85.     CLOSE
  86.     DELAY 1
  87.     CALL FlushKeyBuf
  88.   END
  89.  
  90. '└─────────────────────────────────────────────────────────────────────┘
  91.  
  92. '─── initialize ────────────────────────────────────────────────────────
  93. Initialize:
  94.  
  95.     $DYNAMIC                'All arrays default to dynamic. They
  96.                         ' can be erased after you're finished
  97.                         ' using them.
  98.     SCREEN 0,1: WIDTH 80: CLS        'Color board, 80 columns.
  99.     CLOSE                'Close all open files.
  100.     DEFINT A-Z                'Default all numbers to integer.
  101.     FG =14                'Foreground color.
  102.     BG =1                'Background color.
  103.     KEY OFF                'Turn BASIC soft keys off.
  104.     DIM SaveRow(10), SaveCol(10)    'Screen location arrays.
  105.     ON ERROR GOTO MemoryError           'Memory and other error trap.
  106.   RETURN
  107.  
  108. '─── print init screen ─────────────────────────────────────────────────
  109. InitScreen:
  110.  
  111.     COLOR FG,BG
  112.     LOCATE 10,18
  113.     PRINT "Initializing CrossBas.   Please wait ";
  114.     COLOR FG+16,BG            'Blink screen.
  115.     PRINT "..."
  116.     COLOR FG,BG
  117.   RETURN
  118.  
  119. '─── include files ─────────────────────────────────────────────────────
  120. $INCLUDE "crossbas.inc"            'CrossBas subprograms file.
  121.  
  122. '─── read command line ─────────────────────────────────────────────────
  123. ReadCmdLine:            'Read the DOS command line and use variables found
  124.                         ' there as the input PBASIC source file, the output
  125.                         ' cross-reference table file, and the '/u,' '/s,'
  126.                         ' '/l:n,' '/w:n,' and '/p' switches.  The first
  127.                         ' variable that doesn't start with one of the switch
  128.                         ' strings is assumed to be the source.  If a second
  129.                         ' such string is found, it is assumed to be the output 
  130.                         ' file.  If no output file is found, the input filename
  131.                         ' appended with '.cb' becomes the output filename.
  132.                         ' Other than input/output filename sequence, other
  133.                         ' parameters can be entered in any order.
  134.  
  135.     ON ERROR GOTO MemoryError            'Memory and other errors trap.
  136.     PageFlag =0        'Print page breaks and headers (1).
  137.     ScreenFlag =0    'Print list to screen also (1).
  138.     UcaseFlag =0    'Print list in upper-case (1).
  139.     LMarginMax =8    'Max left margin value.
  140.     WordDimFlag =0    'Word array dimension over-ride flag.
  141.     WordArrayDim =0    'Word array dimension over-ride.
  142.     InFile$ =""         'Input (source) file name and path.
  143.     OutFile$ =""    'Output file name and path.
  144.  
  145.     CALL DimCmdLine(DimCmd)        'Get number of parameters on cmd line.
  146.     DIM Parameter$(1:DimCmd)         'Max number of cmd line parameters.
  147.     CALL ParseCmdLine(Parameter$())    'Get command line parameters.
  148.  
  149.     FOR I = 1 TO DimCmd
  150.       SELECT CASE LEFT$(UCASE$(Parameter$(I)),2)'Check the left two
  151.                               ' characters of the DOS command
  152.                         ' line parameter.
  153.     CASE "/B"    :       FG=7: BG=0    'Black & White over-ride
  154.                                 COLOR FG,BG
  155.         CASE "/P"    :    PageFlag =-1    'Is it the page flag?  (Print
  156.                             ' a page header to the output
  157.                             ' file.)
  158.         CASE "/S"    :    ScreenFlag =-1    'Is it the screen flag?  (Print
  159.                             ' the output file to the screen.)
  160.         CASE "/U"    :    UcaseFlag =-1    'Is it the upper case flag?
  161.                             ' (Print variable names in upper
  162.                             ' case to output file.)
  163.         CASE "/L"    :    GOTO ReadCmdLine.2 'Set the left margin.
  164.         CASE "/W"       :       GOTO ReadCmdLine.3 'Set word array dim.
  165.         CASE ELSE    :    GOTO ReadCmdLine.1 'File name.
  166.         END SELECT
  167.       GOTO ReadCmdLine.9
  168.  
  169. ReadCmdLine.1:                    'Calculate InFile$ and
  170.                         ' OutFile$ names.
  171.     IF InFile$ ="" THEN                         'If no input file specified
  172.         InFile$ =Parameter$(I)            ' this is it.
  173.       ELSEIF OutFile$ ="" THEN            'If no output file specified
  174.         OutFile$ =Parameter$(I)            ' this is it.
  175.       END IF
  176.     GOTO ReadCmdLine.9
  177.  
  178. ReadCmdLine.2:                    'Calculate left margin value.
  179.     LMargin =INSTR(Parameter$(I),":")        'If colon not found then left
  180.     IF LMargin >0 THEN                ' margin switch is invalid.
  181.         Temp$ =MID$(Parameter$(I),LMargin+1)
  182.         IF VAL(Temp$) >0 THEN LMargin =VAL(Temp$) 'If left margin value is a
  183.         IF LMargin >LMarginMax THEN LMargin =LMarginMax ' valid number use it.
  184.       END IF
  185.     GOTO ReadCmdLine.9
  186.  
  187. ReadCmdLine.3:                    'Calculate word array dim value.
  188.     WordArrayDim =INSTR(Parameter$(I),":")    'If colon not found then word
  189.     IF WordArrayDim >0 THEN            ' array dim switch is invalid.
  190.         Temp$ =MID$(Parameter$(I),WordArrayDim+1)
  191.         IF VAL(Temp$) >0 THEN WordArrayDim =VAL(Temp$) 'If word array size
  192.       ELSE                    ' is a value then keep it,
  193.         WordArrayDim =0                ' otherwise dump it.
  194.       END IF
  195.     WordDimFlag =-1                'Word array dim over-ride flag,
  196.                             ' whether 0 or not.
  197.  
  198. ReadCmdLine.9:
  199.       NEXT I                    'Next command line parameter.
  200.  
  201.     IF InFile$ ="" THEN NoFileSpec              'If no input file specified,
  202.                             ' print message and quit.
  203.     IF OutFile$ ="" THEN            'If no output file specified ..
  204.       IF INSTR(InFile$,".") =0 THEN        'If input filename has no ex-
  205.           OutFile$ =InFile$ +".cb"        ' tension then use it with '.cb'
  206.                               ' appended as output filename.
  207.        ELSE
  208.         OutFile$ =LEFT$(InFile$,INSTR(InFile$,".")-1) +".cb"    ''If input file-
  209.                             ' name has an extension, use
  210.                             ' left part of filename appended
  211.                             ' with '.cb' as output filename.
  212.        END IF
  213.      END IF
  214.      ERASE Parameter$                'Deallocate space for command
  215.                                                 ' line parameter array.
  216.   RETURN
  217.  
  218. '─── open files ────────────────────────────────────────────────────────
  219. OpenFiles:
  220.  
  221.       ON ERROR GOTO InFileError        'Trap infile errors.
  222.     OPEN InFile$ FOR INPUT AS #1        'Open input source file.
  223.       InFileSize! =LOF(1)        'Infile size.
  224.  
  225.       ON ERROR GOTO OutFileError    'Trap outfile errors.
  226.     OPEN OutFile$ FOR OUTPUT AS #2      'Make sure this filename will be
  227.                            ' valid for when we need it.
  228.       ON ERROR GOTO MemoryError         'Memory and other error trap.
  229.       CLOSE #2                          'We don't need this now.
  230.   RETURN
  231.  
  232. '─── calculate file names and paths ────────────────────────────────────
  233. CalcFileNames:                'Separate the file names from the
  234.                     ' complete file paths for use in
  235.     CALL CalcName(InFile$,InFileName$)    ' reports.
  236.     CALL CalcName(OutFile$,OutFileName$)
  237.   RETURN
  238.  
  239. '─── read in defaults from default file ────────────────────────────────
  240. ReadDefaults:                'Read default file values.
  241.  
  242.     DefFile$ ="crossbas.def"
  243.       ON ERROR GOTO NulError        'If file not found, then ignore the
  244.     OPEN DefFile$ FOR INPUT AS #11    ' error and create a default file.
  245.       ON ERROR GOTO MemoryError         'Memory and other error trap.
  246.  
  247.     IF ErrorFlag THEN
  248.         ErrorFlag =0             'Reset error flag.
  249.         AvgWordLen  =5             'Average bytes per non-comment words.
  250.         PackingFactor!   =.7        'Percent of file that is non-comment.
  251.         OPEN DefFile$ FOR OUTPUT AS #11    
  252.         WRITE #11,AvgWordLen,PackingFactor!
  253.         PRINT #11,STRING$(72,"-")
  254.         PRINT #11,"This is the CrossBas default file.  Do not make any ";_
  255.             "format changes to"
  256.         PRINT #11,"the first line of this file!
  257.         PRINT #11,
  258.         PRINT #11,"The first field is the average bytes per word you ";_
  259.             "expect to find in"
  260.         PRINT #11,"your source file.  We are concerned with non-comment ";_
  261.             "words only."
  262.         PRINT #11,TAB(66);"[def: 5]"
  263.         PRINT #11,
  264.         PRINT #11,"The second field is the packing factor, the ratio of ";_
  265.             "non-comment words"
  266.         PRINT #11,"to source file length.  This is expressed as a real ";_
  267.             "number less then 1."
  268.         PRINT #11,TAB(66);"[def: .7]"
  269.       ELSE
  270.         INPUT #11,AvgWordLen,PackingFactor!
  271.       END IF
  272.     CLOSE #11                'Close the defaults file.
  273.   RETURN
  274.  
  275.  
  276. '─── check string space vs. effective infile size ──────────────────────
  277. CheckStringSpace:    'Check there is enough string space for the infile
  278.             ' words.
  279.             '(Took this out for PBASIC version.)
  280.  
  281.     IF InFileSize! *PackingFactor! >FRE(S$) THEN 'If the effective infile size
  282.                             ' is bigger than the free
  283.                             ' string space area then
  284.         CLS                    ' quit.
  285.         CLOSE
  286.         PRINT "The calculated effective size of source file, ";
  287.           PRINT UCASE$(InFileName$); ", is ";
  288.           PRINT USING "######,"; InFileSize! *PackingFactor!;
  289.           PRINT " bytes, "
  290.         PRINT "but only ";
  291.           PRINT USING "######,"; FRE(S$);
  292.           PRINT " bytes of string space are available."
  293.         PRINT "Your current default packing factor is ";
  294.           PRINT USING ".##"; PackingFactor!;
  295.           PRINT "    (";
  296.           PRINT USING "###.##"; PackingFactor! *100;
  297.           PRINT " %)"
  298.         PRINT
  299.         PRINT "You have two options:"
  300.         PRINT "1. If you think the packing factor may be too large, ";
  301.           PRINT "try changing it in the";
  302.           PRINT "   defaults file, CROSSBAS.DEF."
  303.         PRINT "2. Try breaking the file up into one main file and one or ";
  304.           PRINT "more include files."
  305.         DELAY 1
  306.         CALL FlushKeyBuf
  307.         END
  308.       END IF
  309.   RETURN
  310.  
  311. '─── calculate word array size ─────────────────────────────────────────
  312. CalcWordArraySize:                'Calculate the approximate
  313.                         ' number of non-reserved words
  314.                         ' in the source file.
  315.  
  316.     IF NOT WordDimFlag THEN            'If no '/w:n' command line over-
  317.                             ' ride value, then calculate one.
  318.         WordArraySize =FIX(InFileSize! *PackingFactor! /AvgWordLen)
  319.                             'Divide file size by avg
  320.       ELSE                    ' word length.
  321.         WordArraySize =WordArrayDim        'Otherwise use over-ride value.
  322.       END IF
  323.   RETURN
  324.  
  325. '─── read in source file lines ─────────────────────────────────────────
  326. ReadAndParseData:            'Read in source file lines.  Parse out
  327.                                         ' words and save them.
  328.  
  329.     ON ERROR GOTO MemoryError        'Memory and other error trap.
  330.     ArrayBytes& =0            'Bytes in string space. At present,
  331.                         ' this is used only to calculate
  332.                         ' the file packing factor. The packing
  333.                         ' factor is the percent of comment to
  334.                         ' non-comment words found in a file.
  335.     DIM Word$(1:WordArraySize)        'Word array.
  336.     DIM LineNo(1:WordArraySize)        'Line number array.
  337.     Wp =0                'Word number.
  338.     L =0                'Initial input file value.
  339.     SP$ =TIME$                'Compare start time.
  340.     GOSUB InitStatusBarP                'Initialize status bar.
  341.     DO UNTIL EOF(1)            'Repeat until end of input file
  342.                         ' encountered.
  343.       INCR L                'Increment line number.
  344.       LINE INPUT #1,TextLine$           'Read a source file line.
  345.       GOSUB ParseTextLine        'Parse the source file line.
  346.       IF FRE(S$) <300 THEN ERROR 14: GOTO MemoryError    'Anticipate string
  347.                                         ' space error.
  348.       GOSUB UpdateStatusBarP        'Update screen status line.
  349.       LOOP                'Do again.
  350.     EP$ =TIME$                'Parse end time.
  351.     CLOSE #1                     'Close input files.
  352.     LMax =L                'Total lines in source file.
  353.     WpMax =Wp                'Total non-reserved words.
  354.   RETURN
  355.  
  356.  
  357. '─── parse text line ───────────────────────────────────────────────────
  358. ParseTextLine:
  359.  
  360.     DelimitFlag =-1            'Last char was a delimiter.
  361.     QuoteFlag =0            'Inside a text literal--ignore.
  362.     NumberFlag =0            'Inside a number--ignore.
  363.     Temp$ =""                'Max chars in source file line.
  364.     CMax =LEN(TextLine$)
  365.  
  366.     FOR C =1 TO CMax
  367.       Char$=MID$(TextLine$,C,1)    'Read one char at a time.
  368.       SELECT CASE Char$
  369.         CASE "'"    :    GOTO ParseTextLine.5    'Remark char.
  370.         CASE " "    :    GOTO ParseTextLine.1    'Delimiter.
  371.         CASE ""        :    GOTO ParseTextLine.1    'Delimiter.
  372.         CASE "="    :       GOTO ParseTextLine.1    'Delimiter.
  373.         CASE ">"    :       GOTO ParseTextLine.1    'Delimiter.
  374.         CASE "<"    :       GOTO ParseTextLine.1    'Delimiter.
  375.         CASE "*"    :       GOTO ParseTextLine.1    'Delimiter.
  376.         CASE "/"    :       GOTO ParseTextLine.1    'Delimiter.
  377.         CASE "-"    :       GOTO ParseTextLine.1    'Delimiter.
  378.         CASE "+"    :       GOTO ParseTextLine.1    'Delimiter.
  379.         CASE "\"    :       GOTO ParseTextLine.1    'Delimiter.
  380.         CASE "_"    :       GOTO ParseTextLine.1    'Delimiter.
  381.         CASE ","    :       GOTO ParseTextLine.1    'Delimiter.
  382.         CASE ";"    :    GOTO ParseTextLine.1    'Delimiter.
  383.         CASE ":"    :    GOTO ParseTextLine.1    'Delimiter.
  384.         CASE "#"    :    GOTO ParseTextLine.6    '<#>
  385.         CASE "."    :    GOTO ParseTextLine.7    '<.>
  386.         CASE "("    :       GOTO ParseTextLine.1    'Delimiter.
  387.         CASE ")"    :       GOTO ParseTextLine.1    'Delimiter.
  388.         CASE CHR$(9)     :    GOTO ParseTextLine.1    '<TAB>
  389.         CASE CHR$(13)     :    GOTO ParseTextLine.1    '<CR>
  390.         CASE "0" TO "9"    :    GOTO ParseTextLine.3    'Number.
  391.         CASE CHR$(34)     :    GOTO ParseTextLine.2    'Quote mark.
  392.         CASE ELSE     :    GOTO ParseTextLine.4    'Normal text.
  393.         END SELECT
  394.  
  395.  
  396. ParseTextLine.1:                'Delimiter found.
  397.     IF QuoteFlag THEN ParseTextLine.8            'If within a quote,
  398.                             ' dump char and get next.
  399.  
  400.     IF DelimitFlag THEN ParseTextLine.8     'If last char was delimiter,
  401.                              ' just dump this one and get
  402.                               ' next char.
  403.  
  404.     IF NumberFlag THEN                         'If last char was number reset
  405.         NumberFlag =0                 ' number flag,
  406.         DelimitFlag =-1                ' reset delimit flag,
  407.         GOTO ParseTextLine.8            ' and get next char.
  408.       END IF
  409.  
  410.     DelimitFlag =-1                'Set delimit flag.
  411.     IF UCASE$(Temp$) ="DATA" THEN ParseTextLine.9 'If the word is DATA or REM,
  412.     IF UCASE$(Temp$) ="REM" THEN ParseTextLine.9  ' ignore rest of line and
  413.                           ' get next.
  414.     IF NOT Temp$ ="" THEN            
  415.       INCR Wp
  416.       Word$(Wp) =Temp$                'Save word and line num in
  417.       LineNo(Wp) =L                ' word array and get ready for
  418.       ArrayBytes& =ArrayBytes& +LEN(Word$(Wp))    ' next word.
  419.       Temp$ =""
  420.       IF Char$ ="(" THEN Word$(Wp) =Word$(Wp) +"()"   'If it is function, proc-
  421.       IF Char$ ="[" THEN Word$(Wp) =Word$(Wp) +"[]"   ' edure or statement that
  422.       END IF                          ' passes variables,
  423.                               ' append the brackets.
  424.     IF Char$ ="'" THEN ParseTextLine.9
  425.       GOTO ParseTextLine.8
  426.  
  427. ParseTextLine.2:                'Quote mark found.
  428.     IF QuoteFlag THEN                    'If within a quote string,
  429.       QuoteFlag =0                ' reset quote flag, dump char
  430.       GOTO ParseTextLine.8            ' and get next character.
  431.      ELSE                       
  432.       QuoteFlag =-1                             'If quote string just starting,
  433.       GOTO ParseTextLine.8            ' set quote flag.
  434.      END IF
  435.  
  436.  
  437. ParseTextLine.3:                'Number character.
  438.     IF QuoteFlag THEN GOTO ParseTextLine.8    'If within a quote,
  439.                         ' dump char and get next.
  440.     IF NumberFlag THEN GOTO ParseTextLine.8
  441.     IF NOT DelimitFlag THEN GOTO ParseTextLine.4 'If number is within
  442.                             ' or at end of a variable
  443.                             ' name it is a normal char.
  444.     NumberFlag =-1                'Set number flag.
  445.     DelimitFlag =0
  446.     GOTO ParseTextLine.8            'Otherwise it is an immediate
  447.                             ' number and ignored.
  448.  
  449.  
  450. ParseTextLine.4:                'Normal character.
  451.     IF QuoteFlag THEN ParseTextLine.8             'If within a quote.
  452.  
  453.     DelimitFlag =0                'Reset delimiter flag.
  454.     NumberFlag =0                'Reset number flag.
  455.  
  456.     Temp$ =Temp$ +Char$                'Build the next word.
  457.     GOTO ParseTextLine.8
  458.  
  459. ParseTextLine.5:                'Remark char encountered.
  460.     IF NOT QuoteFlag THEN             'IF not inside quote string,
  461.         GOTO ParseTextLine.9            ' disregard rest of line
  462.       ELSE                      ' and get next line.
  463.         GOTO ParseTextLine.8            'Else get next char.
  464.       END IF
  465.  
  466. ParseTextLine.6:                '# char.
  467.     IF DelimitFlag THEN ParseTextLine.8            'Dump char and get next.
  468.     GOTO ParseTextLine.4            'If occurs in middle or end of
  469.                             ' word, keep it.
  470.  
  471. ParseTextLine.7:                '. char.
  472.     IF NumberFlag THEN ParseTextLine.8            'Dump char and get next.
  473.     IF DelimitFlag THEN                    'If char occurs at start of
  474.         NumberFlag =-1                ' word, assume it is a
  475.         DelimitFlag =0                ' number.
  476.         GOTO ParseTextLine.8
  477.       END IF
  478.     GOTO ParseTextLine.4            'If not a part of a number,
  479.                             ' treat it as a normal char.
  480.  
  481. ParseTextLine.8:                'Get next character.
  482.     NEXT C
  483.  
  484. ParseTextLine.9:
  485.     IF NOT Temp$ ="" THEN
  486.         INCR Wp
  487.         Word$(Wp) =Temp$
  488.         LineNo(Wp) =L
  489.         ArrayBytes& =ArrayBytes& +LEN(Word$(Wp))
  490.         Temp$ =""
  491.         IF Char$ ="(" THEN Word$(Wp) =Word$(Wp) +"()"   'If it is an array or
  492.         IF Char$ ="[" THEN Word$(Wp) =Word$(Wp) +"[]"   ' function or procedure
  493.       END IF                          ' that passes variables,
  494.   RETURN                          ' append the brackets.
  495.  
  496. '─── compare with reserved words ───────────────────────────────────────
  497. Compare:    'Compare each source file word with all Power-BASIC reserved
  498.         ' words that start with the same first letter as the word.
  499.  
  500.     ON ERROR GOTO MemoryError                   'Memory and other error trap.
  501.     DIM PBWord$(1:36)                'Power-BASIC reserved words.
  502.     Wc =0                    'Compare word index.
  503.     SC$ =TIME$                    'Compare start time.
  504.     GOSUB InitStatusBarC            'Set up status bar or compare.
  505.  
  506.     FOR Wp = 1 TO WpMax
  507.       SELECT CASE LEFT$(UCASE$(Word$(Wp)),1)    'Power-BASIC words starting
  508.         CASE "A"  :       RESTORE DataA        ' with ...
  509.         CASE "B"  :       RESTORE DataB
  510.         CASE "C"  :       RESTORE DataC
  511.         CASE "D"  :       RESTORE DataD
  512.         CASE "E"  :       RESTORE DataE
  513.         CASE "F"  :       RESTORE DataF
  514.         CASE "G"  :       RESTORE DataG
  515.         CASE "H"  :       RESTORE DataH
  516.         CASE "I"  :       RESTORE DataI
  517.         CASE "J"  :       RESTORE DataJ
  518.         CASE "K"  :       RESTORE DataK
  519.         CASE "L"  :       RESTORE DataL
  520.         CASE "M"  :       RESTORE DataM
  521.         CASE "N"  :       RESTORE DataN
  522.         CASE "O"  :       RESTORE DataO
  523.         CASE "P"  :       RESTORE DataP
  524.         CASE "Q"  :       RESTORE DataQ
  525.         CASE "R"  :       RESTORE DataR
  526.         CASE "S"  :       RESTORE DataS
  527.         CASE "T"  :       RESTORE DataT
  528.         CASE "U"  :       RESTORE DataU
  529.         CASE "V"  :       RESTORE DataV
  530.         CASE "W"  :       RESTORE DataW
  531.         CASE "X"  :       RESTORE DataX
  532.         CASE "Y"  :       RESTORE DataY
  533.         CASE "Z"  :       RESTORE DataZ
  534.         CASE "$"  :       RESTORE DataDs    'Dollar sign (metastatements).
  535.         CASE ELSE :       GOTO Compare.1    'Else save it.
  536.       END SELECT
  537.  
  538.     FOR I =1 TO 30            'Blank out array.
  539.       PBWord$(I) =""
  540.       NEXT I
  541.  
  542.     I =0                    'Blank out the T-B word array.
  543.     DO
  544.       INCR I
  545.       READ PBWord$(I)
  546.       LOOP UNTIL PBWord$(I) ="0"
  547.  
  548.     FOR J =1 TO I -1                'Read Power-BASIC words for
  549.       IF UCASE$(Word$(Wp)) =PBWord$(J) GOTO Compare.2    ' comparisons.
  550.       NEXT J
  551.  
  552. Compare.1:
  553.     INCR Wc                    'Increment the compare word
  554.     GOSUB UpdateStatusBarC            ' index, update the status bar
  555.     Word$(Wc) =Word$(Wp)            ' and save word and line no.
  556.     LineNo(Wc)  =LineNo(Wp)            ' to word array.
  557.  
  558. Compare.2:
  559.     NEXT Wp
  560.  
  561.     EC$ =TIME$                    'Compare end time.
  562.     WcMax =Wc                    'Non-Power-BASIC reserved words.
  563.     FOR I =Wc +1 TO Wp                'Blank out extra word array
  564.       Word$(I) =""                ' elements.
  565.       LineNo(I)  =0
  566.       NEXT I
  567.     ERASE PBWord$                'Collapse T-B word array--no
  568.                             ' longer needed.
  569.   RETURN
  570.  
  571. '─── sort the non-PBASIC words ─────────────────────────────────────────
  572. SortWords:        'Bubble sort the non-Power-BASIC words into alpah-
  573.             ' betical order.  Added SortFlag to make it a
  574.             ' modified bubble sort.  If we make a J pass without
  575.             ' making any swaps it means we no more passes are
  576.             ' necessary.  So it cuts the sort short after the
  577.             ' file is in order, even though we haven't gone
  578.             ' through all the passes.  I CrossBas'd a 56k file
  579.             ' with and without the extra sort flag setting and
  580.             ' checking.  The file contained "DEFINT A - Z" at
  581.             ' the beginning, so it had to sort the whole file--
  582.             ' no short cuts.  Without sort flag checking the sort
  583.             ' took 43:11.  With the sort flag checking the sort
  584.             ' took 43:29, only 18 seconds or .7% longer.  There-
  585.             ' fore, for a negligible time increase, worst-case,
  586.             ' we can gain a great deal in cases where the file
  587.             ' may be in a bit of order.
  588.     SS$ =TIME$                    'Sort start time.
  589.     GOSUB InitStatusBarS            'Set up status bar for sort.
  590.     Ws =WcMax                    'Sort index.
  591.     FOR J =Ws TO 1 STEP -1
  592.       FOR I =1 TO J -1
  593.         IF UCASE$(Word$(I)) > UCASE$(Word$(I+1)) THEN    'Compare this word
  594.                             ' and the next.
  595.           SWAP Word$(I), Word$(I+1)        'If next is lower, swap the
  596.           SWAP LineNo(I), LineNo(I+1)        ' word and its line number.
  597.           SortFlag =-1
  598.           END IF
  599.         NEXT I                  'Check next two words.
  600.       GOSUB UpdateStatusBarS            'Update status bar.
  601.       IF NOT SortFlag THEN            'If no sort on last pass,
  602.           J =1                    ' then sorting is finished.
  603.           GOSUB UpdateStatusBarS
  604.         END IF
  605.       SortFlag =0                'Reset sort flag.
  606.       NEXT J                    'Make next pass.
  607.  
  608.     ES$ =TIME$                    'Sort end time.
  609.   RETURN
  610.  
  611. '─── print the list ────────────────────────────────────────────────────
  612. PrintList:        'Print the sorted list to file.  If a word exists more
  613.             ' than once, print it only once.  Print word in left
  614.             ' column.  Print line numbers on the row after the
  615.             ' word, at 6 column intervals.  Extend line numbers
  616.             ' onto the next line(s) if necessary.
  617.  
  618.     Page1Flag =0                'Flag for printing infor-
  619.                             ' mation at top of file.
  620.     I =0                    'Word index.
  621.     SL =0                    'Screen line number.
  622.     PL =0                    'Page line number.
  623.     Page =1                    'File page number.
  624.     LowestL =1                    'If more than one line number
  625.                             ' per word.
  626.     Wu =0                    'Unique words.
  627.     GOSUB CalcPHeader                'Page header, if page flag.
  628.     IF UcaseFlag THEN GOSUB SetUcase        'Convert to ucase if ucase flag.
  629.     OPEN OutFile$ FOR OUTPUT AS #2        'Open cross-ref list file.
  630.     SF$ =TIME$                    'Print to file start time.
  631.     IF LMargin >0 THEN PRINT #2,CHR$(27);"l";CHR$(LMargin); 'Set left margin.
  632.     GOSUB PrintPHeader                'Print page header, if page flag.
  633.     GOSUB InitStatusBarF            'Set up status bar for file print.
  634.     DO
  635.       INCR I                    'Increment word index.
  636.       IF UcaseFlag THEN GOSUB SetUcase        'Convert to ucase if ucase flag.
  637.       IF NOT Word$(I) =Word$(I+1) THEN        'If next word different than
  638.           INCR PL                ' this word...
  639.           INCR SL                'Increment page and screen lines.
  640.           GOSUB CalcInitTab            'Calc file tab values.
  641.           PRINT #2,Word$(I);            'Print the word to file...
  642.           IF ScreenFlag THEN PRINT Word$(I);    'If screen flag, print to screen.
  643.           FOR J =LowestL TO I            
  644.             TabPos =TabPos +6
  645.             IF TabPos >67 THEN             'If past right margin start
  646.                 PRINT #2,            ' new line.
  647.                 IF ScreenFlag THEN PRINT
  648.                 GOSUB PageBreakCk           'Check for page break.
  649.                 GOSUB ScreenBreakCk        'Check for screen break.
  650.                 GOSUB CalcInitTab
  651.                 TabPos =TabPos +6
  652.                 INCR PL                         'Increment page and screen
  653.                 INCR SL                ' line numbers.
  654.               END IF
  655.             PRINT #2,TAB(TabPos);               'Print line numbers after
  656.             PRINT #2,LineNo(J);            ' word.
  657.             IF ScreenFlag THEN                  'If screen flag, print
  658.                 PRINT TAB(TabPos);        ' to screen.
  659.                 PRINT LineNo(J);
  660.               END IF
  661.             NEXT J                      'Print next line number.
  662.           PRINT #2,
  663.           IF ScreenFlag THEN PRINT
  664.           LowestL =I +1
  665.           GOSUB PageBreakCk             'Check for page break.
  666.           GOSUB ScreenBreakCk            'Check for screen break.
  667.           INCR Wu                'Increment unique word index.
  668.           GOSUB UpdateStatusBarF        'Update status bar.
  669.         END IF
  670.       LOOP UNTIL I =WcMax            'Print next word.
  671.       EF$ =TIME$                'Print to file end time.
  672.  
  673.   RETURN
  674.  
  675. '─── print list routines ───────────────────────────────────────────────
  676. SetUcase:        'Convert word to upper-case if upper case flag is set.
  677.  
  678.     Word$(I+1) =UCASE$(Word$(I+1))
  679.   RETURN
  680.  
  681. '─── check for page break ──────────────────────────────────────────────
  682. PageBreakCk:        'Count page lines.  If less then 64, print next line.
  683.             ' If 64 lines, print footer, increment page number,
  684.             ' print page footer.  If page flag is reset, footers
  685.             ' and headers are ignored.  If we page break with more
  686.             ' line numbers to print yet, reprint the word followed
  687.             ' by "(cont'd)"
  688.  
  689.     IF NOT PageFlag THEN RETURN    'If page flag is reset, skip pagebreak.
  690.     IF PL <64 THEN RETURN    'If page number less then 64 print next line.
  691.     GOSUB PrintPFooter        'Print page footer.
  692.     INCR Page            'Increment page number.
  693.     GOSUB PrintPHeader        'Print page header.
  694.     IF (LowestL <I) AND (J <>I) THEN    'If more line numbers to print for word
  695.         Word$(I) =Word$(I) +"(cont'd)"    ' on next page, reprint word.
  696.         GOSUB CalcInitTab
  697.         PRINT #2,Word$(I);
  698.       END IF
  699.   RETURN
  700.  
  701. '─── check for screen break ────────────────────────────────────────────
  702. ScreenBreakCk:        'Count screen lines.  If less then 22, print next line.
  703.             ' If 22 lines, stop screen scroll and wait for keypress.
  704.  
  705.     IF NOT ScreenFlag THEN RETURN        'If screen flag is reset, this
  706.                             ' isn't necessary.
  707.     IF (SL <22) AND (I <>WcMax) THEN RETURN    'If screen line number is 22
  708.     PRINT TAB(20);"... press Q to Quit screen list, or any key to continue";
  709.     CALL FlushKeyBuf                ' stop scroll and wait for
  710.  
  711.     WHILE NOT INSTAT: WEND            'Wait for key press
  712.     LOCATE ,1
  713.     PRINT SPACE$(79);
  714.     LOCATE ,1
  715.     InK$ =INKEY$
  716.     SELECT CASE UCASE$(InK$)            'Quit screen list by pressing Q
  717.       CASE "Q"    :    ScreenFlag =0        ' or <ESC>.  Any other key
  718.       CASE CHR$(27) :    ScreenFlag =0        ' continues screen list.
  719.       END SELECT
  720.     CALL FlushKeyBuf                'Flush the key buffer.
  721.     SL =0                    'Reset screen line number.
  722.   RETURN
  723.  
  724. '─── calculate initial tab space ───────────────────────────────────────
  725. CalcInitTab:        'Calculate the output file tab position for line
  726.             ' numbers.
  727.  
  728.     TabPos =18
  729.     WHILE LEN(Word$(I)) >=(TabPos +6)        'Set tab position to first
  730.       TabPos =TabPos +6                ' increment of 6 longer then
  731.       WEND                    ' the length of the word.
  732.   RETURN
  733.  
  734. '─── calculate page header string ──────────────────────────────────────
  735. CalcPHeader:        'Calc the page header string, consisting of today's
  736.             ' date, the source file name and the page number.
  737.  
  738.     PHeaderA$ =DATE$ +fnCenterJust$("CrossBas: " +UCASE$(InFileName$),51) +_
  739.     "  Page "
  740.     PHeaderB$ ="ver. "+Ver$+"  "+fnCenterJust$(_
  741.     "CrossBas, a Source File Cross-Referencer for Power-BASIC",56)
  742.   RETURN
  743.  
  744. '─── print page header  ────────────────────────────────────────────────
  745. PrintPHeader:        'Print output file headers and footers, if page flag
  746.             ' is set.
  747.  
  748.     IF PageFlag THEN                'If page flag is set
  749.         PRINT #2,                               ' print blank rows.
  750.         PRINT #2,
  751.         PL =3                                   'Initial page line value.
  752.         GOSUB PrintPHeader1            'Print the upper header.
  753.         IF NOT Page1Flag THEN GOSUB PrintPTop    'If this is page 1 print
  754.                             ' a top of report header.
  755.         IF I <WcMax THEN GOSUB PrintPHeader2    'IF this is not the last page
  756.                             ' summary report page, print
  757.       ELSE                    ' the lower header.
  758.         PRINT #2,
  759.         PL =2                    'Initial page line value.
  760.         IF NOT Page1Flag THEN GOSUB PrintPTop   'If page flag is reset, then
  761.                             ' if this is page 1, print a
  762.                             ' top of report header.
  763.       END IF
  764.   RETURN
  765.  
  766. '─── print top of page ─────────────────────────────────────────────────
  767. PrintPTop:        'Print this at the top of the cross-ref list, whether
  768.             ' the page flag is set or not.
  769.     IF NOT PageFlag THEN
  770.         PRINT #2,DATE$;fnCenterJust$("CrossBas Cross-Reference List",52);"  ";_
  771.             TIME$
  772.         INCR PL
  773.       END IF
  774.     PRINT #2,fnCenterJust$("Source: "+UCASE$(InFileName$) +"      "+_
  775.         "List: "+UCASE$(OutFileName$),72)
  776.     PRINT #2,
  777.     INCR PL,2
  778.     Page1Flag =-1
  779.   RETURN
  780.  
  781. '─── print page header 1 ───────────────────────────────────────────────
  782. PrintPHeader1:        'Print the upper page header.
  783.     PRINT #2, PHeaderA$;
  784.     PRINT #2, USING "###";Page
  785.     PRINT #2, PHeaderB$
  786.     INCR PL,4
  787.   RETURN
  788.  
  789. '─── print page header 2 ───────────────────────────────────────────────
  790. PrintPHeader2:        'Print the lower page header.
  791.     PRINT #2,"Variable/Label/Proc";TAB(25);"Physical Line Number"
  792.     INCR PL
  793.   RETURN
  794.  
  795. '─── print page footer ─────────────────────────────────────────────────
  796. PrintPFooter:        'Print the page footer blank lines.
  797.     IF PageFlag THEN
  798.         PRINT #2,CHR$(12);            'Form feed character.
  799.       END IF
  800.   RETURN
  801.  
  802. '─── print bottom of report statistics ─────────────────────────────────
  803. PrintReportBtm:        'Print the summary report at the bottom of the output
  804.             ' file, whether page flag is set or not.
  805.  
  806.     PRINT #2,CHR$(12);                'Pagebreak.
  807.     INCR Page
  808.     GOSUB PrintPHeader                'Print a page header.
  809.     IF NOT PageFlag THEN
  810.     PRINT #2,
  811.         PRINT #2,DATE$;fnCenterJust$(TOSTitle$,52);"  ";TIME$
  812.       END IF
  813.     PRINT #2,fnCenterJust$("-+-+-+- Summary Report -+-+-+-",72)
  814.     PRINT #2,
  815.     PRINT #2,"Options: Upper-case:  ";
  816.       IF UcaseFlag THEN PRINT #2,"Yes"; ELSE PRINT #2,"No";
  817.       PRINT #2,TAB(30);"Screen:   ";
  818.       IF ScreenFlag THEN PRINT #2,"Yes"; ELSE PRINT #2,"No";
  819.       PRINT #2,TAB(49);"Paginate:  ";
  820.       IF PageFlag THEN PRINT #2,"Yes" ELSE PRINT #2,"No"
  821.       PRINT #2,"         Left Margin:";STR$(LMargin);
  822.       PRINT #2,TAB(30);"ArrayDim:";
  823.       IF WordDimFlag THEN
  824.           PRINT #2,STR$(WordArrayDim)           'Print over-ride value.
  825.         ELSE
  826.           PRINT #2," No o/r"                    'No over-ride (/w:n).
  827.         END IF
  828.     PRINT #2,
  829.     PRINT #2,"Read:     ";STR$(LMax);" lines from source file ";_
  830.         UCASE$(InFileName$)
  831.     PRINT #2,"Found:    ";STR$(WpMax);" non-comment words."
  832.     PRINT #2,"Times:     Start: ";SP$,"End: ";EP$," Elapsed: ";
  833.       PRINT #2,fnSecondsToTime$(fnElapsedSeconds&(SP$,EP$))
  834.     PRINT #2,
  835.     PRINT #2,"Compared: ";STR$(WpMax);" non-comment words from source file ";_
  836.         UCASE$(InFileName$)
  837.     PRINT #2,"Found:    ";STR$(WcMax);_
  838.         " non-reserved words (variables, labels, procedures)"
  839.     PRINT #2,"Times:     Start: ";SC$,"End: ";EC$," Elapsed: ";
  840.       PRINT #2,fnSecondsToTime$(fnElapsedSeconds&(SC$,EC$))
  841.     PRINT #2,
  842.     PRINT #2,"Sorted:   ";STR$(Wc);_
  843.         " non-reserved words (variables, labels, procedures)"
  844.     PRINT #2,"Times:     Start: ";SS$,"End: ";ES$," Elapsed: ";
  845.       PRINT #2,fnSecondsToTime$(fnElapsedSeconds&(SS$,ES$))
  846.     PRINT #2,
  847.     PRINT #2,"Printed:  ";STR$(Wu);" unique, non-reserved words to ";_
  848.         UCASE$(OutFileName$)
  849.     PRINT #2,"Times:     Start: ";SF$,"End: ";EF$," Elapsed: ";
  850.       PRINT #2,fnSecondsToTime$(fnElapsedSeconds&(SF$,EF$))
  851.     PRINT #2,
  852.     PRINT #2,"Totals:    Start: ";SP$,"End: ";EF$," Elapsed: ";
  853.       PRINT #2,fnSecondsToTime$(fnElapsedSeconds&(SP$,EF$))
  854.     PRINT #2,
  855.     PRINT #2,"Word Array Size: ";
  856.       PRINT #2,USING "######,";ArrayBytes&;
  857.       PRINT #2," bytes"
  858.     PRINT #2,"Default Word Array Dim.: ";
  859.       PRINT #2, USING "#####,";WordArraySize;
  860.       PRINT #2," wds";
  861.       PRINT #2,TAB(38);"Actual Word Array Dim.: ";
  862.       PRINT #2, USING "#####,";WpMax;
  863.       PRINT #2," wds"
  864.     PRINT #2,"Default Avg.Word Length:     ";
  865.       PRINT #2,USING "##";AvgWordLen;
  866.       PRINT #2," byt";
  867.       PRINT #2,TAB(38);"Actual Avg.Word Length:     ";
  868.       PRINT #2,USING "##";CINT(ArrayBytes& /WpMax);
  869.       PRINT #2," byt"
  870.     PRINT #2,"Default Packing Factor:  ";
  871.       PRINT #2, USING "###.##";PackingFactor!*100;
  872.       PRINT #2," %";
  873.       PRINT #2,TAB(38);"Actual Packing Factor:  ";
  874.       PRINT #2, USING "###.##";ArrayBytes&/InFileSize!*100;
  875.       PRINT #2," %"
  876.     PRINT #2,
  877.     PRINT #2,"Source,    ";UCASE$(InFileName$);",";TAB(26);"File size:";TAB(37);
  878.       PRINT #2,USING "######,";InFileSize!;
  879.       PRINT #2," bytes"
  880.     PRINT #2,"Cross-Ref, ";UCASE$(OutFileName$);",";TAB(26);"File size:";TAB(37);
  881.       OutFileSize! =LOF(2)            'Outfile size in bytes.
  882.       PRINT #2,USING "######,";OutFileSize!+17;
  883.       PRINT #2," bytes"
  884.     PRINT #2,CHR$(12);
  885.     PRINT #2,CHR$(26);                'End of file char (^Z).
  886.     CLOSE #2
  887.   RETURN
  888.  
  889.  
  890. '─── print top of screen report ────────────────────────────────────────
  891. PrintScreenTop:        'Top of screen report.
  892.  
  893.     CLS
  894.     CALL BlankLine(1,BG,FG)            'Blank crt line 1.
  895.     LOCATE 1,1
  896.     TOSTitle$ ="CrossBas Cross-Reference List for "+UCASE$(InFileName$)
  897.                                         ' so far.
  898.     PRINT fnCenterJust$(TOSTitle$,72)
  899.     COLOR FG,BG
  900.     PRINT
  901.     PRINT "Options: Upper-case:  ";
  902.       IF UcaseFlag THEN PRINT "Yes"; ELSE PRINT "No";
  903.     PRINT TAB(30);"Screen:   ";
  904.       IF ScreenFlag THEN PRINT "Yes"; ELSE PRINT "No";
  905.     PRINT TAB(49);"Paginate:  ";
  906.       IF PageFlag THEN PRINT "Yes" ELSE PRINT "No"
  907.     PRINT "         Left Margin:";STR$(LMargin);
  908.     PRINT TAB(30);"ArrayDim:";
  909.     IF WordDimFlag THEN
  910.         PRINT STR$(WordArrayDim)                'Print over-ride value.
  911.       ELSE
  912.         PRINT " No o/r"                         'No over-ride (/w:n).
  913.       END IF
  914.   RETURN
  915.  
  916. '─── print screen report of words found ────────────────────────────────
  917. PrintScreen1:        'Read and parse words screen report.
  918.  
  919.     PRINT
  920.     PRINT "Read:     ";STR$(L);" lines from source file ";UCASE$(InFileName$)
  921.     PRINT "Found:    ";STR$(WpMax);" non-comment words."
  922.     PRINT "Times:     Start: ";SP$,"End: ";EP$," Elapsed: ";
  923.       PRINT fnSecondsToTime$(fnElapsedSeconds&(SP$,EP$))
  924.     DELAY 1
  925.   RETURN
  926.  
  927. '─── print screen report of words compared to reserved words ───────────
  928. PrintScreen2:        'Compare screen report.
  929.  
  930.     PRINT
  931.     PRINT "Compared: ";STR$(WpMax);" non-comment words from source file ";_
  932.         UCASE$(InFileName$)
  933.     PRINT "Found:    ";STR$(WcMax);_
  934.         " non-reserved words (variables, labels, procedures)"
  935.     PRINT "Times:     Start: ";SC$,"End: ";EC$," Elapsed: ";
  936.       PRINT fnSecondsToTime$(fnElapsedSeconds&(SC$,EC$))
  937.     DELAY 1
  938.   RETURN
  939.  
  940. '─── print screen report of words sorted ───────────────────────────────
  941. PrintScreen3:           'Sort screen report.
  942.  
  943.     PRINT
  944.     PRINT "Sorted:   ";STR$(Ws);" non-reserved words (variables, labels, procedures)"
  945.     PRINT "Times:     Start: ";SS$,"End: ";ES$," Elapsed: ";
  946.       PRINT fnSecondsToTime$(fnElapsedSeconds&(SS$,ES$))
  947.     DELAY 1
  948.   RETURN
  949.  
  950. '─── print screen report of words printed ──────────────────────────────
  951. PrintScreen4:        'Print to file screen report.
  952.  
  953.     PRINT
  954.     PRINT "Printed:  ";STR$(Wu);" unique, non-reserved words to ";_
  955.         UCASE$(OutFileName$)
  956.     PRINT "Times:     Start: ";SF$,"End: ";EF$," Elapsed: ";
  957.       PRINT fnSecondsToTime$(fnElapsedSeconds&(SF$,EF$))
  958.     PRINT
  959.     PRINT "Totals:    Start: ";SP$,"End: ";EF$," Elapsed: ";
  960.       PRINT fnSecondsToTime$(fnElapsedSeconds&(SP$,EF$))
  961.     PRINT
  962.     PRINT "CrossBas finished.";
  963.     CALL PushCursor
  964.     CALL BlankLine(25,FG,BG)
  965.     CALL PopCursor
  966.   RETURN
  967.  
  968. '─── initialize status bar for read and parse ──────────────────────────
  969. InitStatusBarP:            'Initialize status bar for read and parse.
  970.  
  971.     CALL PushCursor                'Save cursor position.
  972.     CALL BlankLine(25,BG,FG)            'Blank crt line 25.
  973.     LOCATE 25,2,0
  974.     PRINT "Line:         Word:";        'Print status bar text.
  975.     LOCATE 25,30
  976.     PRINT "CrossBas collecting words in ";UCASE$(InFileName$);
  977.     COLOR FG,BG
  978.     CALL PopCursor                'Restore cursor position.
  979.   RETURN
  980.  
  981.  
  982. '─── initialize status bar for compare ─────────────────────────────────
  983. InitStatusBarC:            'Initialize status bar for compare.
  984.  
  985.     CALL PushCursor                'Save cursor position.
  986.     CALL BlankLine(25,BG,FG)            'Blank crt line 25.
  987.     LOCATE 25,2,0
  988.     PRINT "Word:";                'Print status bar text.
  989.     LOCATE 25,30
  990.     PRINT "CrossBas comparing words in  ";UCASE$(InFileName$);
  991.     COLOR FG,BG
  992.     CALL PopCursor                'Restore cursor position.
  993.   RETURN
  994.  
  995.  
  996. '─── initialize status bar for sort ────────────────────────────────────
  997. InitStatusBarS:            'Initialize status bar for sort.
  998.  
  999.     CALL PushCursor                'Save curosr position.
  1000.     CALL BlankLine(25,BG,FG)            'Blank crt line 25.
  1001.     LOCATE 25,2,0
  1002.     PRINT "Pass:";                'Print status bar text.
  1003.     LOCATE 25,30
  1004.     PRINT "CrossBas sorting words in    ";UCASE$(InFileName$);
  1005.     COLOR FG,BG
  1006.     CALL PopCursor                'Restore cursor position.
  1007.   RETURN
  1008.  
  1009. '─── initialize status bar for file print ──────────────────────────────
  1010. InitStatusBarF:            'Initialize status bar for print to file.
  1011.  
  1012.     CALL PushCursor                'Save cursor position.
  1013.     CALL BlankLine(25,BG,FG)            'Blank crt line 25.
  1014.     LOCATE 25,2,0
  1015.     PRINT "Page:         Word:";        'Print status bar text.
  1016.     LOCATE 25,30
  1017.     PRINT "CrossBas writing words to    ";UCASE$(OutFileName$);
  1018.     COLOR FG,BG
  1019.     CALL PopCursor                'Restore cursor position.
  1020.   RETURN
  1021.  
  1022. '─── update status bar for read and parse ──────────────────────────────
  1023. UpdateStatusBarP:        'Update status bar for read and parse.
  1024.  
  1025.     CALL PushCursor                'Save cursor position.
  1026.     LOCATE 25,8
  1027.     COLOR BG,FG
  1028.     PRINT USING "#####,"; L;                    'Print current source line
  1029.     LOCATE 25,21                ' number.
  1030.     PRINT USING "######,";Wp;            'Print current source word
  1031.     COLOR FG,BG                    ' number.
  1032.     CALL PopCursor                              'Restore cursor position.
  1033.   RETURN
  1034.  
  1035. '─── update status bar for compare ─────────────────────────────────────
  1036. UpdateStatusBarC:        'Compare
  1037.  
  1038.     CALL PushCursor                             'Save cursor position.
  1039.     LOCATE 25,8
  1040.     COLOR BG,FG
  1041.     PRINT USING "#####,"; Wc;            'Print current compare word
  1042.     COLOR FG,BG                    ' number.
  1043.     CALL PopCursor                              'Restore cursor position.
  1044.   RETURN
  1045.  
  1046. '─── update status bar for sort ────────────────────────────────────────
  1047. UpdateStatusBarS:        'Sort
  1048.  
  1049.     CALL PushCursor                             'Save cursor position.
  1050.     LOCATE 25,8
  1051.     COLOR BG,FG
  1052.     PRINT USING "#####,"; J;            'Print current sort word
  1053.     COLOR FG,BG                    ' number.
  1054.     CALL PopCursor                              'Restore cursor position.
  1055.   RETURN
  1056.  
  1057. '─── update status bar for file print ──────────────────────────────────
  1058. UpdateStatusBarF:               'Write to file.
  1059.  
  1060.     CALL PushCursor                             'Save cursor position.
  1061.     LOCATE 25,8
  1062.     COLOR BG,FG
  1063.     PRINT USING "#####,"; Page;            'Print current page number.
  1064.     LOCATE 25,21
  1065.     PRINT USING "######,";Wu;            'Print current unique word
  1066.     COLOR FG,BG                    ' number.
  1067.     CALL PopCursor                              'Restore cursor position.
  1068.   RETURN
  1069.  
  1070. '─── ignore errors ─────────────────────────────────────────────────────
  1071. NulError:        'Ignore errors.
  1072.  
  1073.     ErrorFlag =-1                'Set error flag.
  1074.     RESUME NEXT
  1075.  
  1076.  
  1077. '─── in file rrror routine ─────────────────────────────────────────────
  1078. InFileError:        'InFile error routine.
  1079.  
  1080.     IF INSTR(InFile$,".") =0 THEN        'If file error found and infile
  1081.         InFile$ =InFile$ +".bas"        ' has no extension, append
  1082.         RESUME 0                                ' '.bas' and try again.
  1083.       ELSE
  1084.         BadFile$ =InFile$
  1085.         GOTO BadFileName
  1086.       END IF
  1087.  
  1088. '─── out file error routine ────────────────────────────────────────────
  1089. OutFileError:        'OutFile error routine.
  1090.  
  1091.     IF NOT OutFileFlag THEN            'If haven't already tried
  1092.                             ' new name then try one.
  1093.         IF INSTR(InFile$,".") =0 THEN        'If file/path is invalid
  1094.             OutFileFlag =-1            ' then append '.cb' to
  1095.         OutFile$ =InFile$ +".cb"        ' infile name and try again.
  1096.             RESUME 0
  1097.           ELSE
  1098.             OutFileFlag =-1
  1099.             OutFile$ =LEFT$(InFile$,INSTR(InFile$,".")-1) +".cb"
  1100.             RESUME 0
  1101.           END IF
  1102.         ELSE
  1103.           BadFile$ =OutFile$
  1104.           GOTO BadFileName
  1105.         END IF
  1106.  
  1107.  
  1108. '─── bad file name ─────────────────────────────────────────────────────
  1109. BadFileName:        'Bad source file name.  Tell the user and die.
  1110.  
  1111.     COLOR FG,BG
  1112.     CLS
  1113.     CLOSE
  1114.     PRINT "The file, ";UCASE$(BadFile$); " was not found.  Please try again."
  1115.     CLOSE
  1116.     DELAY 1
  1117.     CALL FlushKeyBuf
  1118.   END
  1119.  
  1120.  
  1121. '─── bad memory or other error ─────────────────────────────────────────
  1122. MemoryError:
  1123.  
  1124.     IF (ERR =242 OR ERR =9) THEN        'Bad word array dimension.
  1125.         ProjArraySize =(InFileSize! /(LOC(1) *128)) *Wp
  1126.         ProjArraySize =FIX((ProjArraySize *1.05)) +1  'Add a little extra.
  1127.         COLOR FG,BG
  1128.         CLS
  1129.         PRINT "The word array dimension was too small."
  1130.         PRINT
  1131.         GOSUB ErrorScrnRpt
  1132.         PRINT
  1133.         IF (NOT WordDimFlag) OR_
  1134.               ((InFileSize! *PackingFactor! /AvgWordLen) <ProjArraySize) THEN
  1135.             PRINT "Try again using the /w:";
  1136.             PRINT RIGHT$(STR$(ProjArraySize),LEN(STR$(ProjArraySize))-1);
  1137.             PRINT " command line switch."
  1138.           ELSE
  1139.             PRINT "Try again without using the /w:n command line switch."
  1140.           END IF
  1141.         CLOSE
  1142.         DELAY 1
  1143.         CALL FlushKeyBuf
  1144.         END
  1145.       ELSEIF ERR =14 THEN                       'Out of string space.
  1146.         COLOR FG,BG
  1147.         CLS
  1148.         PRINT "The string space is exausted.  Source file, ";
  1149.           PRINT UCASE$(InFileName$);", is too large "
  1150.           PRINT "for CrossBas to handle."
  1151.         PRINT
  1152.         GOSUB ErrorScrnRpt
  1153.         PRINT
  1154.         PRINT "Try breaking the file up into one main file and one or ";
  1155.           PRINT "more INClude files."
  1156.         DELAY 1
  1157.         CLOSE
  1158.         CALL FlushKeyBuf
  1159.         END
  1160.       ELSE
  1161.         GOTO CatchRuntimeError
  1162.       END IF
  1163.  
  1164.  
  1165. '─── catch runtime error ───────────────────────────────────────────────
  1166. CatchRuntimeError:    'Catch unexpected errors.
  1167.  
  1168.     CLS
  1169.     CLOSE
  1170.     CALL CatchRuntime            'Print various memory values.
  1171.     DELAY 1
  1172.     CALL FlushKeyBuf            'Flush key buffer.
  1173.   END
  1174.  
  1175. '─── no file spec found on command line ────────────────────────────────
  1176. NoFileSpec:        'No filespec found on command line.  Print basic
  1177.             ' instructions and syntax and die.
  1178.  
  1179.     CLS
  1180.     PRINT "               CrossBas Source File Cross-Referencer for Power-BASIC"
  1181.     LOCATE 1,1: PRINT "ver. ";Ver$
  1182.     PRINT
  1183.     PRINT " CrossBas reads in a Power-BASIC source file (ASCII) and prints ";_
  1184.     "out a variable"
  1185.     PRINT " cross-reference list to a text file. Variable names are listed ";_
  1186.     "alphabetically,"
  1187.     PRINT " followed by the physical source file lines where they appear."
  1188.     PRINT
  1189.     PRINT " Switches:  /bw  Set screen colors to black & white."
  1190.     PRINT "            /p   Paginate output file and print page headers."
  1191.     PRINT "            /u   Print variables in output file in upper case."
  1192.     PRINT "            /s   Print the list to the screen as well as to file."
  1193.     PRINT "            /l:n Set the printer left margin n columns."
  1194.     PRINT "            /w:n Over-ride CrossBas' word array dimension calculation."
  1195.     PRINT
  1196.     PRINT " Syntax:"
  1197.     PRINT "     crossbas infile[.ext] [outfile][.ext] ";_
  1198.     "[/bw][/p][/u][/s][/l:n][/w:n]"
  1199.     DELAY 1
  1200.     CALL FlushKeyBuf
  1201.   END
  1202.  
  1203.  
  1204.  '─── error report to screen ────────────────────────────────────────────
  1205. ErrorScrnRpt:
  1206.  
  1207.     PRINT "Memory Statistics:"
  1208.     PRINT "Stack Space:    ";
  1209.       PRINT USING "######,"; FRE(-2);
  1210.       PRINT TAB(28); "Array Space: ";
  1211.       PRINT USING "######,"; FRE(-1);
  1212.       PRINT TAB(52); "String Space: ";
  1213.       PRINT USING "######,"; FRE(S$)
  1214.     PRINT "End of Memory: ";
  1215.       PRINT USING "#######,"; ENDMEM;
  1216.       PRINT TAB(52); "String Segment:  ";
  1217.       PRINT USING "\  \";fnHexFill$(FRE(S$),4)
  1218.     IF FRE(S$) <300 THEN ERASE Word$        'If out of string segment, we
  1219.                             ' must free some for this report.
  1220.     PRINT
  1221.     IF ERR >0 THEN
  1222.         PRINT "Error #"; STR$(ERR); " occurred at PC counter "; STR$(ERADR)
  1223.         PRINT fnErrorMsg$
  1224.       END IF
  1225.     IF ERDEV >0 THEN
  1226.         PRINT "Error Device: "; ERDEV$; ",  Dev #"; STR$(ERDEV)
  1227.       END IF
  1228.     IF ERR >0 OR ERDEV >0 THEN PRINT
  1229.     PRINT "Source File Size: ";
  1230.       PRINT USING "#######,"; InFileSize!;
  1231.       PRINT " bytes"
  1232.     PRINT "Read so far:       ";
  1233.       IF Wp >0 THEN
  1234.           PRINT USING "######,"; LOC(1) *128;
  1235.         ELSE
  1236.           PRINT USING "######,"; 0;
  1237.         END IF
  1238.       PRINT " bytes"; TAB(52);
  1239.       IF Wp >0 THEN
  1240.           PRINT USING "###.##"; LOC(1) *128 /InFileSize! *100;
  1241.         ELSE
  1242.           PRINT USING "###.##,"; 0;
  1243.         END IF
  1244.       PRINT " %"
  1245.     PRINT
  1246.     PRINT "Words Read:"; TAB(14);
  1247.       PRINT USING "#####,"; Wp;
  1248.       PRINT " words";TAB(35); "Projected Total: "; TAB(52);
  1249.       IF Wp >0 THEN
  1250.           PRINT USING "#####,"; InFileSize! /(LOC(1) *128) *Wp;
  1251.         ELSE
  1252.           PRINT USING "#####,"; 0;
  1253.         END IF
  1254.       PRINT " words"
  1255.     PRINT TAB(13);
  1256.       PRINT USING "######,"; ArrayBytes&;
  1257.       PRINT " bytes";TAB(51);
  1258.       IF Wp >0 THEN
  1259.           PRINT USING "######,"; InFileSize! /(LOC(1) *128) *ArrayBytes&;
  1260.         ELSE
  1261.           PRINT USING "######,"; 0;
  1262.         END IF
  1263.       PRINT " bytes"
  1264.     PRINT "Word Array Dimension:"
  1265.     PRINT TAB(5);"Active:  ";
  1266.       PRINT USING "#####,"; WordArraySize;
  1267.       PRINT " words";TAB(35); "Over-ride:";TAB(52);
  1268.       IF WordDimFlag THEN
  1269.           PRINT USING "#####,"; WordArrayDim;
  1270.           PRINT " words"
  1271.         ELSE
  1272.           PRINT " No o/r"
  1273.         END IF
  1274.     PRINT "Average Word Length:"
  1275.     PRINT TAB(5);"Default: ";
  1276.       PRINT USING "#####,"; AvgWordLen;
  1277.       PRINT " bytes";TAB(35);"Calculated:";TAB(52);
  1278.       IF Wp >0 THEN
  1279.           PRINT USING "#####,"; ArrayBytes& /Wp;
  1280.         ELSE
  1281.           PRINT USING "#####,"; 0;
  1282.         END IF
  1283.       PRINT " bytes"
  1284.     PRINT "Packing Factor:"
  1285.     PRINT TAB(5);"Default:  ";
  1286.       PRINT USING "#.##,"; PackingFactor!;
  1287.       PRINT TAB(35);"Calculated:";TAB(53);
  1288.       IF Wp >0 THEN
  1289.           PRINT USING "#.##,"; ArrayBytes& /(LOC(1) *128)
  1290.         ELSE
  1291.           PRINT USING "#.##,"; 0
  1292.         END IF
  1293.   RETURN
  1294.  
  1295.  
  1296. '─── basic reserved word data ──────────────────────────────────────────
  1297. WordData:
  1298.  
  1299. DataDs:
  1300. DATA $COM, $COM1, $COM2, $COMPILE, $CPU, $DEBUG, $DYNAMIC, $ELSE, $ENDIF
  1301. DATA $ERROR, $EVENT, $FLOAT, $IF, $INCLUDE, $INLINE, $LIB, $LINK, $LIST
  1302. DATA $OPTION, $SEGMENT, $SOUND, $STACK, $STATIC, $STRING, 0
  1303.  
  1304. DataA:
  1305. DATA ABS(), ABSOLUTE, AND, ANY, APPEND, ARRAY, AS, ASC(), ASCEND, ASCII()
  1306. DATA AT, ATN(), 0
  1307.  
  1308. DataB:
  1309. DATA BASE, BEEP, BIN$(), BINARY, BLOAD, BSAVE, 0
  1310.  
  1311. DataC:
  1312. DATA CALL, CASE, CBCD(), CDBL(), CEIL(), CTEXT(), CFIX(), CHAIN, CHDIR
  1313. DATA CHR$(), CINT(), CIRCLE(), CLEAR, CLNG(), CLOSE, CLS, COLLATE
  1314. DATA COLOR, COM(), COMMAND$, COMMON, COS(), CQUD(), CSNG(), CSRLIN
  1315. DATA CVB(), CVD(), CVE(), CVF(), CVI(), CVL(), CVMD(), CVMS(), CVQ()
  1316. DATA CVS(), 0
  1317.  
  1318. DataD:
  1319. DATA DATA, DATE$, DECLARE, DECR, DEF, DEFBCD, DEFDBL, DEFEXT, DEFFIX
  1320. DATA DEFFLX, DEFINT, DEFLNG, DEFQUD, DEFSNG, DEFSTR, DELAY, DELETE
  1321. DATA DESCEND, DIM, DO, DRAW, DYNAMIC, 0
  1322.  
  1323. DataE:
  1324. DATA ELSE, ELSEIF, END, ENDMEM, ENVIRON, ENVIRON$(), EOF(), EQV, ERADR
  1325. DATA ERASE, ERDEV, ERDEV$, ERL, ERR, ERROR, EXECUTE, EXIT, EXP()
  1326. DATA EXP10(), EXP2(), EXTERNAL, EXTRACT$(), 0
  1327.  
  1328. DataF:
  1329. DATA FIELD, FILEATTR(), FILES, FIX(), FIXDIGITS, FLEXCHR$, FN, FOR, FRE()
  1330. DATA FREEFILE, FROM, FUNCTION, 0
  1331.  
  1332. DataG:
  1333. DATA GET, GET(), GET$, GOSUB, GOTO, 0
  1334.  
  1335. DataH:
  1336. DATA HEX$(), 0
  1337.  
  1338. DataI:
  1339. DATA IF, IMP, IN, INCR, INKEY$, INP(), INPUT, INPUT #, INPUT$()
  1340. DATA INSERT, INSTAT, INSTR(), INT(), INTERRUPT, IOCTL, IOCTL$, 0
  1341.  
  1342. DataJ:
  1343. DATA 0
  1344.  
  1345. DataK:
  1346. DATA KEY, KEY(), KILL, 0
  1347.  
  1348. DataL:
  1349. DATA LBOUND(), LCASE$(), LEFT$(), LEN(), LET, LINE, LINE(), LIST, LOC(), LOCAL
  1350. DATA LOCATE, LOF(), LOG(), LOG10(), LOG2(), LOOP, LPOS(), LPRINT, LPRINT #
  1351. DATA LSET, LTRIM$(), 0
  1352.  
  1353. DataM:
  1354. DATA MAP, MAX(), MAX$(), MAX%(), MEMSET, MID$(), MIN(), MIN$(), MIN%()
  1355. DATA MKDIR, MKB$(), MKD$(), MKE$(), MKF$(), MKI$(), MKL$(), MKMD$()
  1356. DATA MKMS$(), MKQ$(), MKS$(), MOD, MTIMER, 0
  1357.  
  1358. DataN:
  1359. DATA NAME, NEXT, NOT, 0
  1360.  
  1361. DataO:
  1362. DATA OCT$(), OFF, ON, OPEN, OPTION, OR, OUT, OUTPUT, 0
  1363.  
  1364. DataP:
  1365. DATA PAINT(), PALETTE, PEEK(), PEEK$(), PEEKI(), PEEKL(), PEN, PEN()
  1366. DATA PLAY, PLAY(), PMAP(), POINT(), POKE, POKE$, POKEI, POKEL, POS
  1367. DATA POS(), PRESET, PRINT, PRINT #, PSET(), PUBLIC, PUT, PUT(), PUT$, 0
  1368.  
  1369. DataQ:
  1370. DATA 0
  1371.  
  1372. DataR:
  1373. DATA RANDOM, RANDOMIZE, READ, REDIM, REG, REG(), REM, REMOVE$(), REPEAT$()
  1374. DATA REPLACE, RESET, RESTORE, RESUME, RETURN, RIGHT$(), RMDIR, RND, RND()
  1375. DATA ROUND(), RSET, RTRIM$(), RUN, 0
  1376.  
  1377. DataS:
  1378. DATA SAVE, SCAN, SCREEN, SCREEN(), SEEK, SEG, SELECT, SERVICE, SGN()
  1379. DATA SHARED, SHELL, SIN(), SORT, SOUND, SPACE$(), SPC(), SQR(), STATIC
  1380. DATA STEP, STICK(), STOP, STR$(), STRIG, STRIG(), STRING$(), STRPTR()
  1381. DATA STRSEG(), SUB, SWAP, SYSTEM, 0
  1382.  
  1383. DataT:
  1384. DATA TAB(), TAGARRAY, TALLY(), TAN(), THEN, TIME$, TIMER, TIMER(), TO
  1385. DATA TROFF, TRON, 0
  1386.  
  1387. DataU:
  1388. DATA UBOUND(), UCASE, UCASE$(), UNTIL, USING, USING$(), USR, USR0, USR1
  1389. DATA USR2, USR3, USR4, USR5, USR6, USR7, USR8, USR9, 0
  1390.  
  1391. DataV:
  1392. DATA VAL(), VARPTR(), VARPTR$(), VARSEG(), VERIFY(), VIEW, VIEW(), 0
  1393.  
  1394. DataW:
  1395. DATA WAIT, WEND, WHILE, WIDTH, WINDOW, WINDOW(), WITH, WRITE, WRITE #, 0
  1396.  
  1397. DataX:
  1398. DATA XOR, 0
  1399.  
  1400. DataY:
  1401. DATA 0
  1402.  
  1403. DataZ:
  1404. DATA 0
  1405.  
  1406. '┌── end of crossbas.bas ──────────────────────────────────────────────┐
  1407. '└─────────────────────────────────────────────────────────────────────┘
  1408.